perm filename MLST.F4[MLI,LCS]1 blob sn#158096 filedate 1975-05-05 generic text, type T, neo UTF8
C  MLST.F4 ----  MAILING LIST PROGRAM---- SPRING 75
C  LOAD WITH MSFAIL[MSS,LCS] (FOR LOOKD)
	COMMON JA
	DIMENSION JA(11,200),JB(7,200),JC(7,200),JD(7,200),JE(7,200),
	1 NA(11)
	IQQ=0
102	U=0
8	K=0
	NB=0
 	TYPE 6
6	FORMAT(' NEW FILE OR OLD?  '$)	
	ACCEPT 10,M
	IF(M.EQ.' '.AND.U.EQ.1)GO TO 43
  	TYPE 22
22	FORMAT(' TYPE A FILE NAME UP TO 5 LETTERS LONG.  '$)
	ACCEPT 23,F
23	FORMAT(A5)
	IF(F.EQ.'     ')GO TO 8
	IF(M.EQ.'O')GO TO 43
10	FORMAT(A1)
200	FORMAT(1XI1,4X$)
15	TYPE 7
7	FORMAT(' TYPE:NAME ON LINE 1,ADDRESS ON LINES 2,3 AND 4,'/
 	1 ' AND UP TO 7 ONE LETTER LIST NAMES ON LINE 5.'/)
	NB=1
2	K=K+1
  	TYPE 3
3	FORMAT(' IF FINISHED TYPE <CR>.'/)
	ACCEPT 9,(JA(I,K),I=1,11)
9	FORMAT(5A1,6A5)
	IF(JA(1,K).EQ.' ')GO TO 33
	IQQ=-1
	L=2
	TYPE 200,L
	ACCEPT 11,(JB(I,K),I=1,7)
11	FORMAT(7A5)
	L=3
	TYPE 200,L
	ACCEPT 11,(JC(I,K),I=1,7)
	L=4
	TYPE 200,L
	ACCEPT 11,(JE(I,K),I=1,7)
	L=5
	TYPE 200,L
	ACCEPT 20,(JD(I,K),I=1,7)
20   	FORMAT(7A1)
	GO TO 2
43	IF(LOOKD(F))GO TO 44
    	TYPE 58,F
58	FORMAT(1XA5,' FILE NOT FOUND.'/)
	GO TO 102
44	REWIND 1
	CALL IFILE(1,F)
	READ(1)K,((JB(I,L),I=1,7),L=1,K)
	READ(1)((JA(I,L),I=1,11),L=1,K)
	READ(1)((JC(I,L),I=1,7),L=1,K)
	READ(1)((JE(I,L),I=1,7),L=1,K)
	READ(1)((JD(I,L),I=1,7),L=1,K),K
134	TYPE 66
66	FORMAT(' TYPE ADD,CHANGE,DELETE OR <CR> FOR PRINTOUT.  '$)
	ACCEPT 10,P
	IF(P.EQ.'A')GO TO 15
	IF(P.NE.'C'.AND.P.NE.'D')GO TO 146
110	TYPE 111
111	FORMAT(' TYPE NAME OR IF FINISHED TYPE <CR>.'/)
	ACCEPT 9,(NA(I),I=1,11)
	IF(NA(1).EQ.' ')GO TO 134
	IQQ=-1
	DO 114 N=1,K
	J=0
	DO 114 I=1,11
	IF(JA(I,N).EQ.NA(I))J=J+1
	IF(J.EQ.11)GO TO 148
114	CONTINUE
	TYPE 116
116	FORMAT(' NAME NOT FOUND.'/)
	GO TO 134
148	IF(P.EQ.'D')GO TO 149
	NB=1
   	TYPE 117
117	FORMAT(' TYPE NEW NAME OR <CR> FOR NO CHANGE.'/)
	ACCEPT 9,(NA(I),I=1,11)
	IF(NA(1).EQ.' ')GO TO 119
	DO 131 I=1,11
131	JA(I,N)=NA(I)
119	TYPE 136,(JB(I,N),I=1,7)
	TYPE 121
121	FORMAT(' TYPE NEW ADDRESS LINE OR <CR> FOR NO CHANGE.'/)
	ACCEPT 11,(NA(I),I=1,7)
136	FORMAT(1X7A5)
	IF(NA(1).EQ.' ')GO TO 122
	DO 123 I=1,7	
123	JB(I,N)=NA(I)
122	TYPE 136,(JC(I,N),I=1,7)
	TYPE 121
	ACCEPT 11,(NA(I),I=1,7)
	IF(NA(1).EQ.' ')GO TO 300
	DO 125 I=1,7
125	JC(I,N)=NA(I)
300	TYPE 136,(JE(I,N),I=1,7)
	TYPE 121
	ACCEPT 11,(NA(I),I=1,7)
	IF(NA(1).EQ.' ')GO TO 124
	DO 301 I=1,7
301	JE(I,N)=NA(I)
124	TYPE 137,(JD(I,N),I=1,7)
137	FORMAT(1X7A1)
	TYPE 127
127	FORMAT(' TYPE NEW LIST NAMES OR <CR> FOR NO CHANGE.'/)
	ACCEPT 20,(NA(I),I=1,7)
	IF(NA(1).EQ.' ')GO TO 134
	DO 129 I=1,7
129	JD(I,N)=NA(I)	
	GO TO 134
33	K=K-1
   	P=' '
146	IF(NB.EQ.0)GO TO 132
104	JK=1
	JX=1
1004	L=LN(JK)
	DO 2004 J=JK+1,K
	N=LN(J)
	IF(L.LE.N)GO TO 2004
	L=N
	JX=J
2004	CONTINUE
	IF(JX.EQ.JK)GO TO 8004
	DO 3004 J=1,11
	CALL EXCH(JA(J,JX),JA(J,JK))
	IF(J.GT.7)GO TO 3004
	CALL EXCH(JB(J,JX),JB(J,JK))
	CALL EXCH(JC(J,JX),JC(J,JK))
	CALL EXCH(JD(J,JX),JD(J,JK))
	CALL EXCH(JE(J,JX),JE(J,JK))
3004	CONTINUE
8004	JK=JK+1
	JX=JK
	IF(JK.LT.K)GO TO 1004
	GO TO 132
6004	FORMAT(' DELETE THIS ONE?  '$)
149	L=LN(N)
	JS=-1
	DO 5004 J=1,K-1
	IF(L.NE.LN(J))GO TO 5004
	TYPE 6004
	ACCEPT 20,N
	IF(N.EQ.'N')GO TO 5004
	DO 7004 JJ=J,K
	JS=JJ+1
	DO 7004 JQ=1,11
	JA(JQ,JJ)=JA(JQ,JS)
	IF(JQ.GT.7)GO TO 7004
	JB(JQ,JJ)=JB(JQ,JS)
	JC(JQ,JJ)=JC(JQ,JS)
	JD(JQ,JJ)=JD(JQ,JS)
	JE(JQ,JJ)=JE(JQ,JS)
7004	CONTINUE
	IF(JS)GO TO 134
	K=K-1
	NB=NB+NB
	GO TO 134
5004	CONTINUE
	GO TO 134
132	IF(IQQ.EQ.0)GO TO 60
	REWIND 1
	CALL OFILE(1,F)
	WRITE(1)K,((JB(I,L),I=1,7),L=1,K),K
	WRITE(1)((JA(I,L),I=1,11),L=1,K),K
	WRITE(1)((JC(I,L),I=1,7),L=1,K),K
	WRITE(1)((JE(I,L),I=1,7),L=1,K),K
	WRITE(1)((JD(I,L),I=1,7),L=1,K),K,K
	END FILE 1
60	TYPE 77
77	FORMAT(' TYPE LIST NAME OR <CR> FOR ALL LISTS.'/)
	ACCEPT 10,JF
	Y=' '
 	IF(JF.EQ.' ')GO TO 53
	N=1
	DO 99 L=1,K
	DO 97 I=1,7
	IF(JD(I,L).EQ.JF)GO TO 98
97	CONTINUE
	GO TO 99
98	DO 51 M=1,11
51	JA(M,N)=JA(M,L)
	DO 100 M=1,7
	JB(M,N)=JB(M,L)
   	JC(M,N)=JC(M,L)
	JE(M,N)=JE(M,L)
100	JD(M,N)=JD(M,L)
	N=N+1
99	CONTINUE
	K=N-1
53	Y='Y'
  	TYPE 13
13	FORMAT(' TTY OR LINE PRINTER?'/)
	ACCEPT 10,T
	IF(T.NE.'L')GO TO 103
  	TYPE 88
88	FORMAT(' PRINT WITH LIST NAMES?'/)
	ACCEPT 10,Y
103	LIST=5
	IF(T.EQ.'L')LIST=3
	WRITE(LIST,91)F,JF
91	FORMAT(//28XA5,' FILE',4XA1,' LIST'/)
	ID=1
	DO 45 J=1,K,2
	IF(K.EQ.J)ID=0
	NN=J+ID
	WRITE(LIST,19)((JA(I,L),I=1,11),L=J,NN)
19	FORMAT(//2(2X5A1,6A5))
	WRITE(LIST,46)((JB(I,L),I=1,7),L=J,NN)
46	FORMAT(2(2X7A5))
	WRITE(LIST,46)((JC(I,L),I=1,7),L=J,NN)
	WRITE(LIST,46)((JE(I,L),I=1,7),L=J,NN)
	IF(Y.NE.'Y')GO TO 45
	WRITE(LIST,48)((JD(I,L),I=1,7),L=J,NN)
48	FORMAT(/5X7A1,30X7A1)
45	CONTINUE
	IF(T.EQ.'L')CALL EXIT
	U=1
	GO TO 8
	END

	FUNCTION LN(M)
	COMMON JA(11,200)
	MX=100000000
	LN=0
	DO 1 K=1,5
	J=JA(K,M)
	IF(J)LN=LN+(1-('A'-J)/536870912)*MX
C  ONLY LOOKS AT LETTERS (A-Z ARE NEG.)
1	MX=MX/100
	RETURN
	END

	SUBROUTINE EXCH(J,K)
	L=J
	J=K
	K=L
	END